MacTech 1 to 12

home *** CD-ROM | disk | FTP | other *** search

/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.04 Apr 91 / Assoc. Arrays / GameMonitor.st next >

Wrap

Text File | 1990-04-22 | 13.6 KB | 495 lines | [TEXT/MACV]

"*************************************************" "* special classes to override built-in behavior *" "* *" "* MyButtonPane bypasses the checks for 'text *" "* modified' when a button is pressed, and *" "* MyGraphPane eliminates scroll bars on the *" "* pane. *" "*************************************************" ButtonPane subclass: #MyButtonPane instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' ! !MyButtonPane class methods ! ! !MyButtonPane methods ! selectAtCursor "Press the button at the current cursor position." | | 1 to: boxes size do: [ :i | ((boxes at: i) containsPoint: Cursor offset) ifTrue: [ ^ self buttonPressed: i ] ].! ! GraphPane subclass: #MyGraphPane instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' ! !MyGraphPane class methods ! ! !MyGraphPane methods ! addMenus: menuBar "dummy for addSubPane" "needed to eliminate scroll bars on GraphPane" | |! ! "********************************" "* begin Game Monitor *" "********************************" Object subclass: #GameMonitor instanceVariableNames: '' classVariableNames: 'CatWins ActivePlayers PromptPane MoveRequestor AllPlayers LogPane GetMovePane TheBoard WhoseMove GameOver ' poolDictionaries: '' ! !GameMonitor class methods ! initialize: aBoard "Create the monitor panes with aBoard as model, also initialize any variables whose value persists across games." | topPane | (topPane := TopPane new) label: 'Monitor'. topPane addSubpane: (PromptPane := MyGraphPane new model: aBoard; name: #dummyUpdate1:; framingRatio: (0@0 extent: 2/3 @ (1/6))). topPane addSubpane: (GetMovePane := TextPane new model: aBoard; name: #dummyUpdate; framingRatio: (0@(1/6) extent: 2/3 @ (1/6))). topPane addSubpane: (LogPane := TextPane new model: aBoard; name: #dummyUpdate; framingRatio: (0@(1/3) extent: 1@(2/3))). topPane addSubpane: (MyButtonPane new model: aBoard; buttons: #(Move); change: #readMove:; pulse: true; framingRatio: (2/3 @ 0 extent: 1/3 @ (1/3))). "initialize persistent values" CatWins := 0. TheBoard := aBoard.! ! !GameMonitor methods ! dummyUpdate "private - do nothing to update TextPane" | | ^'' "have to send back something, or it won't work"! dummyUpdate1: aRect "private - initialize form for GraphPane" | aForm | aForm := Form width: aRect width height: aRect height. aForm white; offset: aRect origin. ^aForm.! gameOver "private - called from moveOver if the game is now over" | playAgain | self loggit: '---game over'. "ask for another game" self loggit: 'Scores: (Cat got ', (CatWins printPaddedTo: 4) , ')'. AllPlayers do: [:aPlayer | aPlayer printScore]. "To have the computer play itself continuously, the following statement should be replaced with playAgain := 'Yes'." playAgain :=Prompter prompt: 'Play again?' default: 'Yes'. (playAgain = 'Yes') ifTrue: [ TheBoard reset. self restartPlayers ] ifFalse: [self loggit: '***play is over'. "this releases the players and board" AllPlayers := nil. TheBoard := nil.].! loggit: aString "write aString to the LogPane, supplying the Cr" | | LogPane appendString: aString; appendChar: (CharacterConstants at: 'Cr'); displayChanges.! moveOver "This is the main loop of the monitor. If the game is not over yet, it determines the next active player and tells him to make a move. If the game is over, it so states, prints statistics, and asks if you want to play again." "A game is over either when one player declares himself the winner, or if all players have resigned." | | TheBoard showBoard. GameOver ifFalse: [ "move to next player" WhoseMove := WhoseMove \\ (AllPlayers size) + 1. [ActivePlayers at: WhoseMove] whileFalse: [WhoseMove := WhoseMove \\ (AllPlayers size) + 1]. (AllPlayers at: WhoseMove) yourMove. ] ifTrue: [ self gameOver ].! readMove: whichButton "private - Send the move read (the entire text) to the requestor. Argument whichButton is not used, since there's only one button" | holdRequestor theMove | holdRequestor := MoveRequestor. theMove := GetMovePane contents. "kludge to eliminate trailing Cr" ((theMove at: (theMove size)) = (CharacterConstants at: 'Cr')) ifTrue: [theMove := theMove copyFrom:1 to: (theMove size - 1)]. "now clear the panes, and the requestor" PromptPane form white. PromptPane update; showWindow. GetMovePane selectAll; replaceWithText: ''; update. MoveRequestor := nil. holdRequestor haveProposedMove: theMove.! requestMove: aPrompt "request the human player to make a move by saying aPrompt" | aPen | MoveRequestor := self. (Pen new: (PromptPane form)) defaultNib: 1; place: ((PromptPane form extent) // 2); centerText: aPrompt font: (Font applicationFont). PromptPane showWindow. "the move wil be returned in a haveProposedMove message"! resign "A player resigns from the game, or admits defeat. If all players resign, the Cat wins" | | self loggit: (self name) , ' says he resigns ' . ActivePlayers at: WhoseMove put: false. "game is over if there are no move players" (ActivePlayers includes: true) ifFalse: [GameOver := true. CatWins := CatWins + 1.]. self moveOver.! restartPlayers "private - start players at beginning of game" | | GameOver := false. 1 to: (AllPlayers size) do: [:i | ActivePlayers at: i put: true]. AllPlayers do: [:aPlayer | aPlayer newGame]. WhoseMove := 1. (AllPlayers at: WhoseMove) yourMove.! startPlay: allPlayers "record the Array of all Players" "call the first player" | topPane | topPane := LogPane topPane. topPane dispatcher open. AllPlayers := allPlayers. ActivePlayers := Array new: (allPlayers size). self restartPlayers. topPane dispatcher scheduleWindow.! win "declare oneself the winner" | | self loggit: (self name) , ' says he wins'. GameOver := true. "notify all players of status" AllPlayers do: [:aPlayer | (aPlayer = self) ifTrue: [aPlayer youWin] ifFalse: [aPlayer youLose]]. self moveOver.! ! "******************************" "* GameBoard class definition *" "******************************" GameMonitor subclass: #GameBoard instanceVariableNames: 'width height positions ' classVariableNames: '' poolDictionaries: '' ! !GameBoard class methods ! ! !GameBoard methods ! allLegalMoves "answer an OrderedCollection of all valid moves from this position" | | self implementedBySubclass.! getPositions "answer a copy of the array of the board position" | | ^ positions deepCopy.! move: m "Record a move by player WhoseMove" "Answer: #Win, if the player wins on this move #Ok, if this is a legal move #Error, if this is an illegal move (and do not record the move)" | | self implementedBySubclass.! reset "reset the board back to the start" | | self implementedBySubclass.! setWidth: w height: h "private - initialize board dimensions" | | width := w. height := h.! showBoard "display the current board position" "subclasses may override this to get a different display" | oneLine aPlayer | 1 to: height do: [:row | oneLine := ''. 1 to: width do: [:col | aPlayer := positions at: width*(row - 1) + col. aPlayer isNil ifTrue: [aPlayer := '.'] ifFalse: [aPlayer := (AllPlayers at: aPlayer) marker]. oneLine := oneLine , aPlayer. ]. self loggit: oneLine. ]! ! "******************************" "* Player class definition *" "******************************" GameMonitor subclass: #Player instanceVariableNames: 'gamesWon whoAmI marker ' classVariableNames: '' poolDictionaries: '' ! !Player class methods ! new: aName marker: aMarker "create a new instance for player aName; aMarker will mark his pieces on the board" | aPlayer | aPlayer := super new. aPlayer name: aName marker: aMarker. aPlayer clear. ^ aPlayer! ! !Player methods ! clear "private - clear any needed variables" | | gamesWon := 0.! haveProposedMove: aMove "send the proposed move, yielded by requestMove:, to the original requestor" | | self implementedBySubclass! marker "answer the marker of this player" | | ^ marker.! name "answer the player's name" | | ^ whoAmI! name: aName marker: aMarker "private - record name and marker of new player" | | whoAmI := aName. marker := aMarker.! newGame "reinitialize for new game - subclasses may supplement this" | |! printScore "private - print the number of games won on the LogPane" | | self loggit: whoAmI , (gamesWon printPaddedTo: 4).! youLose "Sent to player at end of game, if he lost." "May be supplemented in subclass." | |! yourMove "tells a Player it is his move" | | self implementedBySubclass! youWin "Sent to player at end of game, if he won." "May be supplemented in subclass." | | gamesWon := gamesWon + 1.! ! Player subclass: #ComputerPlayer instanceVariableNames: 'matchboxes lastMove lastBoardPosition ' classVariableNames: '' poolDictionaries: '' ! !ComputerPlayer class methods ! new: aName marker: aMarker "create a new ComputerPlayer" | aPlayer | aPlayer := super new: aName marker: aMarker. aPlayer createMatchboxes. ^aPlayer.! ! !ComputerPlayer methods ! createMatchboxes "private - create the Dictionary of matchboxes upon new:" | | matchboxes := Dictionary new.! newGame "clear detritus from previous game" | | lastMove := nil. lastBoardPosition := nil.! "**********************************************" "* The matchboxes are implemented in youLose *" "* and yourMove. *" "**********************************************" youLose "delete the losing move from the matchboxes" | tempMoves | lastBoardPosition isNil ifTrue: [self error: 'ComputerPlayer can''t move'] ifFalse: [tempMoves := (matchboxes at: lastBoardPosition) deepCopy. tempMoves remove: lastMove. matchboxes at: lastBoardPosition put: tempMoves. ]. ! yourMove "generate the next move for this player" | theMoves copyBoardPosition moveResult | copyBoardPosition := TheBoard getPositions. (matchboxes includesKey: copyBoardPosition) ifFalse: [ "new position - add all possible moves" matchboxes at: copyBoardPosition put: (TheBoard allLegalMoves) ]. theMoves := matchboxes at: copyBoardPosition. ((theMoves size)=0) ifTrue: [ "we are blocked - resign" self resign. ^nil] ifFalse: [ "pick a move at random, and remember the move in case it is a loser" lastMove := theMoves at: (1 + (SmallInteger random: (theMoves size))). lastBoardPosition := copyBoardPosition. moveResult := (TheBoard move: lastMove). (moveResult = #Win) ifTrue: [self win] ifFalse:[ (moveResult = #Ok) ifTrue: [ self moveOver ] ifFalse: ["no good - internal error" self error: 'ComputerPlayer ' , 'attempted ', 'illegal move' ]. ] ]! ! Player subclass: #HumanPlayer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' ! !HumanPlayer class methods ! ! !HumanPlayer methods ! retryMove "ask human to try again - his move was no good" | | self loggit: 'Try again!!'; yourMove.! yourMove "ask the human for his move; it will be returned in a haveProposedMove message" | | self requestMove: whoAmI , '''s move?'! !